home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 2004 #2 / Amiga Plus CD - 2004 - No. 02.iso / AmigaPlus / Tools / Development / AmigaTalk / testfiles / TestNewGadTool < prev    next >
Encoding:
Text File  |  2004-01-31  |  14.9 KB  |  485 lines
  1. ('   Starting TestNewGadTool...') print
  2.  
  3. amigatalk tracingOff
  4.  
  5. )i Amigatalk:User/UserGUI.st
  6.  
  7. amigatalk tracingOn
  8.  
  9. scr        <- amigatalk activeScreen
  10. win        <- Window     new: 'Testing NewGadgets:'
  11. userGUI    <- UserGUI    new
  12. intuition  <- Intuition  new
  13.  
  14. tagDone <- intuition systemTag: #TAG_DONE
  15.  
  16. userGUI setScreen: scr
  17.  
  18. gadList <- GadgetSystem new: userGUI
  19.  
  20. xOffset <- scr getWBorLeftSize
  21. yOffset <- scr getBarHeightSize
  22.  
  23. viObj   <- gadList visualInfo   " or use:  scr getVisualInfo: nil "
  24.  
  25. bType   <- intuition systemTag: #BUTTON_KIND
  26. sType   <- intuition systemTag: #STRING_KIND
  27. iType   <- intuition systemTag: #INTEGER_KIND
  28.  
  29. iTags   <- Array new: 7
  30.  
  31. iTags at: 1 put: (intuition systemTag: #GTIN_MaxChars)
  32. iTags at: 2 put: 8
  33. iTags at: 3 put: (intuition systemTag: #GTIN_Number)
  34. iTags at: 4 put: 98765432
  35. iTags at: 5 put: (intuition systemTag: #GT_Underscore)
  36. iTags at: 6 put: $_
  37. iTags at: 7 put: tagDone
  38.  
  39. bTags   <- Array new: 5
  40.  
  41. bTags at: 1 put: (intuition systemTag: #GA_ToggleSelect)
  42. bTags at: 2 put: 1
  43. bTags at: 3 put: (intuition systemTag: #GT_Underscore)
  44. bTags at: 4 put: $_
  45. bTags at: 5 put: tagDone
  46.  
  47. exitArray <- Array new: 12
  48.  
  49. exitArray at: 1  put: (xOffset + 4)
  50. exitArray at: 2  put: (yOffset + 92)
  51. exitArray at: 3  put: 87
  52. exitArray at: 4  put: 19
  53. exitArray at: 5  put: '_Exit'
  54. exitArray at: 6  put: (gadList textAttributes)
  55. exitArray at: 7  put: 1
  56. exitArray at: 8  put: 0
  57. exitArray at: 9  put: viObj
  58. exitArray at: 10 put: #testButtonGadget " See method in NewGadget.st/ButtonGadget "
  59. exitArray at: 11 put: bType
  60. exitArray at: 12 put: $E
  61.  
  62. ('   Creating the ButtonGadget...') print
  63. exitButton <- ButtonGadget new: (exitArray at: 10)
  64. exitButton setup: exitArray
  65.  
  66. getFileArray <- Array new: 12
  67.  
  68. amigatalk tracingOff
  69.  
  70. getFileArray at: 1  put: (xOffset + 425)
  71. getFileArray at: 2  put: (yOffset + 37)
  72. getFileArray at: 3  put: 20
  73. getFileArray at: 4  put: 11
  74. getFileArray at: 5  put: nil
  75. getFileArray at: 6  put: nil
  76. getFileArray at: 7  put: 2
  77. getFileArray at: 8  put: 0
  78. getFileArray at: 9  put: viObj
  79. getFileArray at: 10 put: #testGetFileGadget
  80. getFileArray at: 11 put: (intuition systemTag: #GENERIC_KIND)
  81. getFileArray at: 12 put: nil
  82.  
  83. ('   Creating the GetFileGadget...') print
  84. fileButton <- GetFileGadget new: (getFileArray at: 10)
  85. fileButton setup: getFileArray
  86.  
  87. intArray <- Array new: 12
  88.  
  89. intArray at: 1  put: (xOffset + 120)
  90. intArray at: 2  put: (yOffset + 115)
  91. intArray at: 3  put: 100
  92. intArray at: 4  put: 20
  93. intArray at: 5  put: 'Test _Integer:'
  94. intArray at: 6  put: (gadList textAttributes)
  95. intArray at: 7  put: 3
  96. intArray at: 8  put: (intuition systemTag: #PLACETEXT_LEFT)
  97. intArray at: 9  put: viObj
  98. intArray at: 10 put: #testIntegerGadget
  99. intArray at: 11 put: iType
  100. intArray at: 12 put: $I
  101.  
  102. ('   Creating the IntegerGadget...') print
  103. intGadget <- IntegerGadget new: 45
  104. intGadget setup: intArray
  105.  
  106. chkTags   <- Array new: 5
  107.  
  108. chkTags at: 1 put: (intuition systemTag: #GTCB_Checked)
  109. chkTags at: 2 put: 1
  110. chkTags at: 3 put: (intuition systemTag: #GT_Underscore)
  111. chkTags at: 4 put: $_
  112. chkTags at: 5 put: tagDone
  113.  
  114. chkArray <- Array new: 12
  115.  
  116. chkArray at: 1  put: (xOffset + 125)
  117. chkArray at: 2  put: (yOffset + 75)
  118. chkArray at: 3  put: 30
  119. chkArray at: 4  put: 19
  120. chkArray at: 5  put: '_CheckBox Test:'
  121. chkArray at: 6  put: (gadList textAttributes)
  122. chkArray at: 7  put: 4
  123. chkArray at: 8  put: ((intuition systemTag: #PLACETEXT_LEFT) \
  124.                     + (intuition systemTag: #NG_HIGHLABEL))    
  125. chkArray at: 9  put: viObj
  126. chkArray at: 10 put: #testCheckBoxGadget
  127. chkArray at: 11 put: (intuition systemTag: #CHECKBOX_KIND)
  128. chkArray at: 12 put: $C
  129.  
  130. ('   Creating the CheckBoxGadget...') print
  131. chkGadget <- CheckBoxGadget new: nil
  132. chkGadget setup: chkArray
  133.  
  134. txtArray <- Array new: 12
  135.  
  136. txtArray at: 1  put: (xOffset + 125)
  137. txtArray at: 2  put: (yOffset + 145)
  138. txtArray at: 3  put: 200
  139. txtArray at: 4  put: 19
  140. txtArray at: 5  put: 'Text Test:'
  141. txtArray at: 6  put: (gadList textAttributes)
  142. txtArray at: 7  put: 5
  143. txtArray at: 8  put: (intuition systemTag: #PLACETEXT_LEFT)
  144. txtArray at: 9  put: viObj
  145. txtArray at: 10 put: #testTextGadget
  146. txtArray at: 11 put: (intuition systemTag: #TEXT_KIND)
  147. txtArray at: 12 put: nil
  148.  
  149. txtTags <- Array new: 5
  150.  
  151. txtTags at: 1 put: (intuition systemTag: #GTTX_Text)
  152. txtTags at: 2 put: 'Default Display Text'
  153. txtTags at: 3 put: (intuition systemTag: #GTTX_Border)
  154. txtTags at: 4 put: 1
  155. txtTags at: 5 put: tagDone
  156.  
  157. ('   Creating the TextGadget...') print
  158. txtGadget <- TextGadget new: nil
  159. txtGadget setup: txtArray
  160.  
  161. sTags   <- Array new: 7
  162.  
  163. sTags at: 1 put: (intuition systemTag: #GTST_MaxChars)
  164. sTags at: 2 put: 80
  165. sTags at: 3 put: (intuition systemTag: #STRINGA_Justification)
  166. sTags at: 4 put: (intuition systemTag: #GACT_STRINGCENTER)
  167. sTags at: 5 put: (intuition systemTag: #GT_Underscore)
  168. sTags at: 6 put: $_
  169. sTags at: 7 put: tagDone
  170.  
  171. strArray <- Array new: 12
  172.  
  173. strArray at: 1  put: (xOffset + 120)
  174. strArray at: 2  put: (yOffset + 35)
  175. strArray at: 3  put: 300
  176. strArray at: 4  put: 20
  177. strArray at: 5  put: '_Test String:'
  178. strArray at: 6  put: (gadList textAttributes)
  179. strArray at: 7  put: 6
  180. strArray at: 8  put: (intuition systemTag: #PLACETEXT_LEFT)
  181. strArray at: 9  put: viObj
  182. strArray at: 10 put: #testStringGadget
  183. strArray at: 11 put: sType
  184. strArray at: 12 put: $T
  185.  
  186. ('   Creating the StringGadget...') print
  187. strGadget <- StringGadget new: nil
  188. strGadget setup: strArray
  189.  
  190. numArray <- Array new: 12
  191.  
  192. numArray at: 1  put: (xOffset + 340)
  193. numArray at: 2  put: (yOffset + 115)
  194. numArray at: 3  put: 120
  195. numArray at: 4  put: 20
  196. numArray at: 5  put: 'Test Number:'
  197. numArray at: 6  put: (gadList textAttributes)
  198. numArray at: 7  put: 7
  199. numArray at: 8  put: (intuition systemTag: #PLACETEXT_LEFT)
  200. numArray at: 9  put: viObj
  201. numArray at: 10 put: #testNumberGadget
  202. numArray at: 11 put: (intuition systemTag: #NUMBER_KIND)
  203. numArray at: 12 put: nil " Does NOT really do anything for read-only Gadgets "
  204.  
  205. numTags <- Array new: 7
  206.  
  207. numTags at: 1 put: (intuition systemTag: #GTNM_Number)
  208. numTags at: 2 put: 16r10000000
  209. numTags at: 3 put: (intuition systemTag: #GTNM_Border)
  210. numTags at: 4 put: 1
  211. numTags at: 5 put: (intuition systemTag: #GTNM_MaxChars)
  212. numTags at: 6 put: 12
  213. numTags at: 7 put: tagDone
  214.  
  215. ('   Creating the NumberGadget...') print
  216. numGadget <- NumberGadget new: 45
  217. numGadget setup: numArray
  218.  
  219. palArray <- Array new: 12
  220.  
  221. palArray at: 1  put: (xOffset + 500)
  222. palArray at: 2  put: (yOffset + 20)
  223. palArray at: 3  put: 180
  224. palArray at: 4  put: 120
  225. palArray at: 5  put: 'Test _Palette:'
  226. palArray at: 6  put: (gadList textAttributes)
  227. palArray at: 7  put: 8
  228. palArray at: 8  put: (intuition systemTag: #PLACETEXT_ABOVE)
  229. palArray at: 9  put: viObj
  230. palArray at: 10 put: #testPaletteGadget
  231. palArray at: 11 put: (intuition systemTag: #PALETTE_KIND)
  232. palArray at: 12 put: $P
  233.  
  234. palTags <- Array new: 7
  235.  
  236. palTags at: 1 put: (intuition systemTag: #GTPA_Depth)
  237. palTags at: 2 put: 8
  238. palTags at: 3 put: (intuition systemTag: #GTPA_Color)
  239. palTags at: 4 put: 1
  240. palTags at: 5 put: (intuition systemTag: #GT_Underscore)
  241. palTags at: 6 put: $_
  242. palTags at: 7 put: tagDone
  243.  
  244. ('   Creating the PaletteGadget...') print
  245. palGadget <- PaletteGadget new: 256
  246. palGadget setup: palArray
  247.  
  248. cycArray <- Array new: 12
  249.  
  250. cycArray at: 1  put: (xOffset + 30)
  251. cycArray at: 2  put: (yOffset + 190)
  252. cycArray at: 3  put: 100
  253. cycArray at: 4  put: 20
  254. cycArray at: 5  put: 'Test C_ycle:'
  255. cycArray at: 6  put: (gadList textAttributes)
  256. cycArray at: 7  put: 9
  257. cycArray at: 8  put: (intuition systemTag: #PLACETEXT_ABOVE)
  258. cycArray at: 9  put: viObj
  259. cycArray at: 10 put: #testCycleGadget
  260. cycArray at: 11 put: (intuition systemTag: #CYCLE_KIND)
  261. cycArray at: 12 put: $Y
  262.  
  263. ('   Creating the CycleGadget...') print
  264. cycGadget <- CycleGadget new: #( 'Cycler' 'Working...' 'Just Fine!' )
  265. cycTags   <- Array       new: 7
  266.  
  267. cycTags at: 1 put: (intuition systemTag: #GTCY_Active)
  268. cycTags at: 2 put: 2
  269. cycTags at: 3 put: (intuition systemTag: #GT_Underscore)
  270. cycTags at: 4 put: $_
  271. cycTags at: 5 put: (intuition systemTag: #GTCY_Labels)
  272. cycTags at: 6 put: (cycGadget choicesTag)              " NOTE WELL! "
  273. cycTags at: 7 put: tagDone
  274.  
  275. cycGadget setup: cycArray
  276.  
  277. mxArray <- Array new: 12
  278.  
  279. mxArray at: 1  put: (xOffset + 160)
  280. mxArray at: 2  put: (yOffset + 200)
  281. mxArray at: 3  put: 20                        "Meaningless for MX_KIND"
  282. mxArray at: 4  put: 20                        "Meaningless for MX_KIND"
  283. mxArray at: 5  put: 'Test MX (Radio)'
  284. mxArray at: 6  put: (gadList textAttributes)
  285. mxArray at: 7  put: 10
  286. mxArray at: 8  put: (intuition systemTag: #PLACETEXT_RIGHT)
  287. mxArray at: 9  put: viObj
  288. mxArray at: 10 put: #testMXGadget
  289. mxArray at: 11 put: (intuition systemTag: #MX_KIND)
  290. mxArray at: 12 put: nil                       "Meaningless for MX_KIND"
  291.   
  292. ('   Creating the MXGadget...') print
  293. mxGadget <- MXGadget new: #( 'Thin' 'Just right' 'Fat' )
  294. mxTags   <- Array    new: 9
  295.  
  296. mxTags at: 1 put: (intuition systemTag: #GTMX_Active)
  297. mxTags at: 2 put: 2
  298. mxTags at: 3 put: (intuition systemTag: #GTMX_TitlePlace)
  299. mxTags at: 4 put: (intuition systemTag: #PLACETEXT_ABOVE)
  300. mxTags at: 5 put: (intuition systemTag: #GTMX_Spacing)
  301. mxTags at: 6 put: 3
  302. mxTags at: 7 put: (intuition systemTag: #GTMX_Labels)
  303. mxTags at: 8 put: (mxGadget choicesTag)               " NOTE WELL! "
  304. mxTags at: 9 put: tagDone
  305.  
  306. mxGadget setup: mxArray
  307.  
  308. lvArray <- Array new: 12
  309.  
  310. lvArray at: 1  put: (xOffset + 320)
  311. lvArray at: 2  put: (yOffset + 200)
  312. lvArray at: 3  put: 150
  313. lvArray at: 4  put: 140
  314. lvArray at: 5  put: 'Test _ListView:'
  315. lvArray at: 6  put: (gadList textAttributes)
  316. lvArray at: 7  put: 11
  317. lvArray at: 8  put: (intuition systemTag: #PLACETEXT_ABOVE)
  318. lvArray at: 9  put: viObj
  319. lvArray at: 10 put: #testListViewGadget
  320. lvArray at: 11 put: (intuition systemTag: #LISTVIEW_KIND)
  321. lvArray at: 12 put: $L
  322.   
  323. ('   Creating the ListViewGadget...') print
  324. lvGadget <- ListViewGadget new: #( 'String0' 'String1' 'List Viewer' 'To the rescue!' )
  325. lvTags   <- Array    new: 11
  326.  
  327. lvTags at: 1  put: (intuition systemTag: #GTLV_Selected)
  328. lvTags at: 2  put: 1
  329. lvTags at: 3  put: (intuition systemTag: #LAYOUTA_Spacing)
  330. lvTags at: 4  put: 2
  331. lvTags at: 5  put: (intuition systemTag: #GTLV_Labels)
  332. lvTags at: 6  put: (lvGadget choicesTag)                 " NOTE WELL! "
  333. lvTags at: 7  put: (intuition systemTag: #GT_Underscore)
  334. lvTags at: 8  put: $_
  335. lvTags at: 9  put: (intuition systemTag: #GTLV_ShowSelected)
  336. lvTags at: 10 put: 0
  337. lvTags at: 11 put: tagDone
  338.  
  339. lvGadget setup: lvArray
  340.  
  341. slideArray <- Array new: 12
  342.  
  343. slideArray at: 1  put: 20
  344. slideArray at: 2  put: 300
  345. slideArray at: 3  put: 150
  346. slideArray at: 4  put: 20
  347. slideArray at: 5  put: 'Test _Slider:'
  348. slideArray at: 6  put: (gadList textAttributes)
  349. slideArray at: 7  put: 12
  350. slideArray at: 8  put: (intuition systemTag: #PLACETEXT_ABOVE)
  351. slideArray at: 9  put: viObj
  352. slideArray at: 10 put: #testSliderGadget
  353. slideArray at: 11 put: (intuition systemTag: #SLIDER_KIND)
  354. slideArray at: 12 put: $S
  355.   
  356. ('   Creating the SliderGadget...') print
  357. slGadget <- SliderGadget new: (intuition systemTag: #LORIENT_HORIZ)
  358. slTags   <- Array    new: 19
  359.  
  360. slTags at:  1 put: (intuition systemTag: #GTSL_Min)
  361. slTags at:  2 put: 0
  362. slTags at:  3 put: (intuition systemTag: #GTSL_Max)
  363. slTags at:  4 put: 50
  364. slTags at:  5 put: (intuition systemTag: #GTSL_Level)
  365. slTags at:  6 put: 20
  366. slTags at:  7 put: (intuition systemTag: #GT_Underscore)
  367. slTags at:  8 put: $_
  368. slTags at:  9 put: (intuition systemTag: #GT_RelVerify)
  369. slTags at: 10 put: 1
  370. slTags at: 11 put: (intuition systemTag: #GA_Immediate)
  371. slTags at: 12 put: 1
  372. slTags at: 13 put: (intuition systemTag: #PGA_Freedom)
  373. slTags at: 14 put: (intuition systemTag: #LORIENT_HORIZ)
  374. slTags at: 15 put: (intuition systemTag: #GTSL_LevelFormat)
  375. slTags at: 16 put: '%02ld'
  376. slTags at: 17 put: (intuition systemTag: #GTSL_LevelPlace)
  377. slTags at: 18 put: (intuition systemTag: #PLACETEXT_BELOW)
  378. slTags at: 19 put: tagDone
  379.  
  380. slGadget setup: slideArray
  381.  
  382. slGadget setMin: 0 max: 50
  383.  
  384. ('   Please wait for IDCMP Loop start...') print
  385.  
  386. firstGad <- gadList gadgetContext
  387.  
  388. next1 <- lvGadget   addToGList: gadList at: firstGad with: lvTags
  389.  
  390. next2 <- fileButton addToGList: gadList at: next1 with: nil
  391. next3 <- intGadget  addToGList: gadList at: next2 with: iTags
  392. next4 <- chkGadget  addToGList: gadList at: next3 with: chkTags
  393. next5 <- txtGadget  addToGList: gadList at: next4 with: txtTags
  394. next6 <- strGadget  addToGList: gadList at: next5 with: sTags
  395. next7 <- numGadget  addToGList: gadList at: next6 with: numTags
  396. next8 <- palGadget  addToGList: gadList at: next7 with: palTags
  397. next9 <- cycGadget  addToGList: gadList at: next8 with: cycTags
  398. nextA <- mxGadget   addToGList: gadList at: next9 with: mxTags
  399. nextB <- exitButton addToGList: gadList at: nextA with: bTags
  400. nextC <- slGadget   addToGList: gadList at: nextB with: slTags
  401.  
  402. wFlags <-  (intuition systemTag: #WFLG_ACTIVATE)
  403. wFlags <- ((intuition systemTag: #WFLG_CLOSEGADGET) bitOr: wFlags)
  404. wFlags <- ((intuition systemTag: #WFLG_DEPTHGADGET) bitOr: wFlags)
  405. wFlags <- ((intuition systemTag: #WFLG_RMBTRAP)     bitOr: wFlags)
  406.  
  407. wIDCMP <-  (intuition systemTag: #IDCMP_CLOSEWINDOW)
  408. wIDCMP <- ((intuition systemTag: #IDCMP_VANILLAKEY)    bitOr: wIDCMP)
  409. wIDCMP <- ((intuition systemTag: #IDCMP_REFRESHWINDOW) bitOr: wIDCMP)
  410. wIDCMP <- ((intuition systemTag: #PALETTEIDCMP)        bitOr: wIDCMP)
  411. wIDCMP <- ((intuition systemTag: #BUTTONIDCMP)         bitOr: wIDCMP)
  412. wIDCMP <- ((intuition systemTag: #CHECKBOXIDCMP)       bitOr: wIDCMP)
  413. wIDCMP <- ((intuition systemTag: #CYCLEIDCMP)          bitOr: wIDCMP)
  414. wIDCMP <- ((intuition systemTag: #INTEGERIDCMP)        bitOr: wIDCMP)
  415. wIDCMP <- ((intuition systemTag: #STRINGIDCMP)         bitOr: wIDCMP)
  416. wIDCMP <- ((intuition systemTag: #MXIDCMP)             bitOr: wIDCMP)
  417. wIDCMP <- ((intuition systemTag: #LISTVIEWIDCMP)       bitOr: wIDCMP)
  418. wIDCMP <- ((intuition systemTag: #SLIDERIDCMP)         bitOr: wIDCMP)
  419.  
  420. win setFlags:       wFlags
  421. win setIDCMPFlags:  wIDCMP
  422. win setFirstGadget: firstGad
  423.  
  424. win setWindowOrigin:    0 @   0
  425. win setWindowSize:    800 @ 400
  426.  
  427. win openOnScreen: scr
  428.  
  429. userGUI setWindow: win
  430.  
  431. scr screenToFront
  432.  
  433. itxt1 <-IText new: 'Explore the various NewGadgets:'
  434.  
  435. itxt1 setPens:         3 @ 0
  436. itxt1 setITextOrigin:  0 @ 0
  437.  
  438. win printIText: itxt1 at: 30 @ 30
  439.  
  440. userGUI addControl: exitButton named: 1
  441. userGUI addControl: fileButton named: 2
  442. userGUI addControl: intGadget  named: 3
  443. userGUI addControl: chkGadget  named: 4
  444. userGUI addControl: txtGadget  named: 5 " Does NOT do anything for read-only Gadgets "
  445. userGUI addControl: strGadget  named: 6
  446. userGUI addControl: numGadget  named: 7 " Does NOT do anything for read-only Gadgets "
  447. userGUI addControl: palGadget  named: 8
  448. userGUI addControl: cycGadget  named: 9
  449. userGUI addControl: mxGadget   named: 10
  450. userGUI addControl: lvGadget   named: 11
  451. userGUI addControl: slGadget   named: 12
  452.  
  453. strGadget value: 'Enter your name in here!'
  454. txtGadget value: 'Updated Text Contents'
  455. intGadget value: 12345678
  456. numGadget value: 16r7FFFFFFF
  457.  
  458. ('   Starting the IDCMP loop...') print 
  459.  
  460. userGUI startUp " Here we stay until User asks for exit "
  461.  
  462. ('   IDCMP loop terminated!') print
  463.  
  464. itxt1 dispose
  465.  
  466. win close
  467. scr disposeVisualInfo: viObj
  468.  
  469. slGadget   dispose
  470. lvGadget   dispose
  471. mxGadget   dispose
  472. cycGadget  dispose
  473. palGadget  dispose
  474. numGadget  dispose
  475. chkGadget  dispose
  476. intGadget  dispose
  477. txtGadget  dispose
  478. strGadget  dispose
  479. exitButton dispose
  480. fileButton dispose
  481.  
  482. gadList    dispose
  483.  
  484. ('   TestNewGadTool done!') print
  485.